home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Delphi Programmer's Power Pack
/
Delphi Volume 1.iso
/
s_to_z
/
tsmtp11
/
uucode.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1996-09-15
|
8KB
|
344 lines
{.$DEFINE UseBits}
unit UUCode;
interface
uses Classes,SysUtils,Forms,Dialogs;
const
MaxChars = 45;
type
TCodeMethod = (cdUU,cdXX);
T45Bytes = array[1..MaxChars] of byte;
T60Bytes = array[1..2*MaxChars] of byte;
TBuffer = array[1..$FFF0] of byte;
{A special class for bitwise operations}
{$IFDEF UseBits}
T24Bits = class
private
Bits : array[0..MaxChars] of byte;
public
procedure SetBit(BitNo : word);
function BitIsOn(BitNo : word) : boolean;
procedure Clear;
end;
{$ELSE}
T24Bits = array[0..8*MaxChars] of boolean;
{$ENDIF}
EUUInvalidCharacter = class(Exception)
constructor Create;
end;
TUUCode = class
private
StringList : TStringList;
Stream : TStream;
CurSection : byte;
A24Bits : T24Bits;
FCodeMethod : TCodeMethod;
FCheckSums : boolean;
FOnProgress : TNotifyEvent;
FOnStart : TNotifyEvent;
FOnEnd : TNotifyEvent;
procedure SetCodeMethod(Value : TCodeMethod);
function Generate60Bytes(tb : T45Bytes; NumOfBytes : byte) : string;
procedure Generate45Bytes(InS : string; A45Bytes : pointer;
var BytesGenerated : word);
function ByteFromTable(Ch : Char) : byte;
procedure DoProgress(Sender : TObject);
procedure DoStart(Sender : TObject);
procedure DoEnd(Sender : TObject);
public
Progress : Integer;
ProgressStep : Integer;
Canceled : boolean;
Table : string;
constructor Create(AStream : TStream; AStringList : TStringList);
{$IFDEF UseBits}
destructor Destroy; override;
{$ENDIF}
procedure Encode;
procedure Decode;
property CodeMethod : TCodeMethod read FCodeMethod
write SetCodeMethod default cdUU;
property CheckSums : boolean read FCheckSums write FCheckSums
default false;
property OnProgress : TNotifyEvent read FOnProgress
write FOnProgress;
property OnStart : TNotifyEvent read FOnStart write FOnStart;
property OnEnd : TNotifyEvent read FOnEnd write FOnEnd;
end;
implementation
{$IFDEF UseBits}
procedure T24Bits.SetBit(BitNo : word);
var
i : byte;
begin
i:=BitNo div 8;
Bits[i]:=Bits[i] or (1 shl (BitNo mod 8));
end;
function T24Bits.BitIsOn(BitNo : word) : boolean;
var
j : byte;
begin
j:=BitNo mod 8;
Result:=Bits[BitNo div 8] and (1 shl j)=1 shl j;
end;
procedure T24Bits.Clear;
begin
FillChar(Bits,SizeOf(Bits),0);
end;
{$ENDIF}
constructor EUUInvalidCharacter.Create;
begin
inherited Create('Invalid character in the input file');
end;
{TUUCode}
constructor TUUCode.Create(AStream : TStream; AStringList : TStringList);
begin
inherited Create;
Stream:=AStream;
StringList:=AStringList;
ProgressStep:=10;
FCodeMethod:=cdUU;
Table:='`!"#$%&''()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_';
FCheckSums:=false;
{$IFDEF UseBits}
A24Bits:=T24Bits.Create;
{$ELSE}
FillChar(A24Bits,SizeOf(A24Bits),0);
{$ENDIF}
end;
{$IFDEF UseBits}
destructor TUUCode.Destroy;
begin
A24Bits.Free;
inherited Destroy;
end;
{$ENDIF}
procedure TUUCode.SetCodeMethod(Value : TCodeMethod);
begin
if Value<>FCodeMethod then
begin
FCodeMethod:=Value;
if Value=cdUU then
begin
Table:='`!"#$%&''()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_';
end
else
begin
Table:='+-0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz';
end;
end;
end;
procedure TUUCode.DoProgress(Sender : TObject);
begin
if Assigned(FOnProgress) then
FOnProgress(Sender);
end;
procedure TUUCode.DoStart(Sender : TObject);
begin
if Assigned(FOnStart) then
FOnStart(Sender);
end;
procedure TUUCode.DoEnd(Sender : TObject);
begin
if Assigned(FOnEnd) then
FOnEnd(Sender);
end;
function TUUCode.Generate60Bytes(tb : T45Bytes; NumOfBytes : byte) : string;
{Converts 45 bytes of binary data to 60 bytes of text}
var
i,j,k,b,m : word;
CheckSum : word;
s : string;
begin
k:=0;
{$IFDEF UseBits}
A24Bits.Clear;
{$ELSE}
FillChar(A24Bits,SizeOf(T24Bits),0);
{$ENDIF}
for i:=1 to MaxChars do
begin
b:=tb[i];
for j:=7 DownTo 0 do
begin
m:=1 shl j;
if (b and m = m) then
{$IFDEF UseBits}
A24Bits.SetBit(k);
{$ELSE}
A24Bits[k]:=true;
{$ENDIF}
Inc(k);
end;
end;
s:=''; k:=0; m:=4*(MaxChars div 3);
CheckSum:=0;
for i:=1 to m do
begin
b:=0;
for j:=5 DownTo 0 do
begin
{$IFDEF UseBits}
if A24Bits.BitIsOn(k) then b:= b or (1 shl j);
{$ELSE}
if A24Bits[k] then b:= b or (1 shl j);
{$ENDIF}
Inc(k);
end;
s[i]:=Table[b+1];
if FCheckSums then
Inc(CheckSum,b);
end;
if NumOfBytes=MaxChars then s[0]:=Char(4*MaxChars div 3)
else s[0]:=Char(4*NumOfBytes div 3 + 1);
if FCheckSums then
s:=Concat(s,Table[CheckSum mod 64 + 1]);
Result:=Concat(Table[NumOfBytes+1],s);
end;
procedure TUUCode.Encode;
var
BytesRead : word;
A45Bytes : T45Bytes;
Total : LongInt;
begin
DoStart(Self);
StringList.Clear;
Progress:=0; Total:=0; Canceled:=false;
try
repeat
BytesRead:=Stream.Read(A45Bytes,MaxChars);
Inc(Total,BytesRead);
StringList.Add(Generate60Bytes(A45Bytes,BytesRead));
Progress:=100*Total div Stream.Size;
if Progress mod ProgressStep = 0 then
DoProgress(Self);
Application.ProcessMessages;
until (BytesRead<MaxChars) or Canceled;
finally
Progress:=100;
DoProgress(Self);
if Canceled then StringList.Clear;
DoEnd(Self);
end;
end;
function TUUCode.ByteFromTable(Ch : Char) : byte;
var
i : byte;
begin
i:=1;
while (Ch<>Table[i]) and (i<=64) do Inc(i);
if i>64 then
begin
if Ch=' ' then Result:=0
else raise EUUInvalidCharacter.Create;
end;
Result:=i-1;
end;
procedure TUUCode.Generate45Bytes(InS : string; A45Bytes : pointer;
var BytesGenerated : word);
{converts 60 bytes of text to 45 bytes of binary data}
var
i,j,k,b,m : word;
InSLen : byte absolute InS;
ActualLen : byte;
begin
FillChar(A45Bytes^,MaxChars,0);
{$IFDEF UseBits}
A24Bits.Clear;
{$ELSE}
FillChar(A24Bits,SizeOf(T24Bits),0);
{$ENDIF}
k:=0;
ActualLen:=4*ByteFromTable(InS[1]) div 3;
if ActualLen<>(4*MaxChars div 3) then
ActualLen:=InSLen-1;
for i:=2 to ActualLen+1 do
begin
b:=ByteFromTable(InS[i]);
for j:=5 DownTo 0 do
begin
m:=1 shl j;
if (b and m = m) then
{$IFDEF UseBits}
A24Bits.SetBit(k);
{$ELSE}
A24Bits[k]:=true;
{$ENDIF}
Inc(k);
end;
end;
k:=0;
for i:=1 to MaxChars do
begin
b:=0;
for j:=7 DownTo 0 do
begin
{$IFDEF UseBits}
if A24Bits.BitIsOn(k) then b:= b or (1 shl j);
{$ELSE}
if A24Bits[k] then b:= b or (1 shl j);
{$ENDIF}
Inc(k);
end;
TBuffer(A45Bytes^)[i]:=b;
end;
BytesGenerated:=ByteFromTable(InS[1]);
end;
procedure TUUCode.Decode;
var
A45Bytes : T45Bytes;
BytesGenerated : word;
i : LongInt;
s : string;
p : pointer;
begin
DoStart(Self);
Progress:=0;
Canceled:=false;
try
GetMem(p,MaxChars);
i:=0;
repeat
s:=StringList.Strings[i];
Generate45Bytes(s,p,BytesGenerated);
Stream.Write(p^,BytesGenerated);
Progress:=(100*i) div (StringList.Count-1);
if Progress mod ProgressStep = 0 then
DoProgress(Self);
Application.ProcessMessages;
if Canceled then break;
Inc(i);
until (i=StringList.Count) or (StringList[i]='end')
or (StringList[i]=Table[1]);
finally
Progress:=100;
DoProgress(Self);
FreeMem(p,MaxChars);
DoEnd(Self);
end;
end;
end.